SuperHack/SuperHack CD.bin/CODING/DELPHI/VIMVCL23.ZIP/DEMO2S.PAS

Pascal/Delphi Source File | 1996-04-19 | 5.7 KB | 227 lines

unit Demo2s;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Grids, viminbox, VimSess,
  Menus, vim;

type
  TForm1 = class(TForm)
    VimSession1: TVimSession;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    attachmentsList: TListBox;
    toList: TListBox;
    ccList: TListBox;
    newcomp1: TVimInbox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo2: TMemo;
    procedure StringGrid1Click(Sender: TObject);
    procedure attachmentsListDblClick(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure FormActivate(Sender: TObject);
    procedure StringGrid1DblClick(Sender: TObject);
    procedure doGridDraw(forceDraw:boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
{
    newComp:TVimAddressBook;
    newComp1:TVimInbox;
    }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.StringGrid1Click(Sender: TObject);
var
  i:integer;
  s:string;
begin
  if stringGrid1.cells[1,0] = '' then
    exit;
  with newcomp1 do begin
    getMessage(inboxContents.count-TStringGrid(sender).row);
    {setMessageAsRead(inboxContents.count-TStringGrid(sender).row);}
    memo1.lines.assign(messageLines);
    toList.items.assign(toNames);
    ccList.items.assign(CC);
    if attachments.count <> 0 then
      for i := 0 to attachments.count-1 do begin
        str(TVimAttachment(attachments.objects[i]).size,s);
        attachmentsList.items.add(attachments.strings[i]+' '+s+' bytes');
      end
    else
      attachmentsList.clear;
  end;
end;

procedure TForm1.attachmentsListDblClick(Sender: TObject);
var
  lb:TLIstBox;
  i:integer;
  s:string;
begin
  lb := TListBox(Sender);
  i := lb.itemIndex;
  newcomp1.saveAttachment(i,'C:\');
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
var
  lRow, lCol:longint;
begin
  lRow := row;
  lCol := col;
  with (Sender as TStringGrid) do
    with Canvas do begin
      if (bool(stringGrid1.objects[0, row])) and
         (stringGrid1.rowCount <> 0) and
         (row > 0) then begin
        brush.color := clAqua;
        font.color := clBlack;
      end else begin
        if lrow = 0 then begin
          brush.color := stringgrid1.fixedcolor;
          font.color := clBlack;
        end else begin
          brush.color := clWhite;
          font.color := clBlack;
        end;
      end;
      fillRect(rect);
      TextRect(Rect, Rect.Left + 3, Rect.Top + 3, cells[lcol, lrow]);
  end;
end;

procedure TForm1.doGridDraw(forceDraw:boolean);
function NewTextWidth(fntFont : TFont; const sString : OpenString) :
  integer;
var
  fntSave : TFont;
begin
  result := 0;
  fntSave := Application.MainForm.Font;
  Application.MainForm.Font := fntFont;
  try
    result := Application.MainForm.Canvas.TextWidth(sString);
  finally
    Application.MainForm.Font := fntSave;
  end;
end;

function iCalcGridWidth
  (
  sg : TStringGrid { the grid to meaure }
  )
  : integer; { the "exact" width }

const
  cMEASURE_CHAR   = '0';
  iEXTRA_COL_PIX  = 4;
  iINDICATOR_WIDE = 11;
var
  i, iColumns, iRows, iColWidth, t : integer;
begin
  iColumns := 0;
  result := GetSystemMetrics(SM_CXVSCROLL);
  with sg do
    for iColumns := 0 to colCount- 1 do begin
      iColWidth := 0;
      for iRows := 0 to rowCount - 1 do begin
        t := NewTextWidth(sg.Font, cells[iColumns,iRows]);
        if t > iColWidth then
        iColWidth := t;
      end;
      if goVertLine in sg.Options
        then inc(iColWidth);
      ColWidths[iColumns] := iColWidth;
    end;
end;
var
  i:integer;
  k:integer;
  s:string;
begin
  if vimsession1.active = false then
    vimsession1.active := true;
  if newcomp1.active = true then begin
    if not forceDraw then
      exit;
  end else begin
    newComp1.scanInboxOnACtivate := false;
    newcomp1.active := true;
    newComp1.scanInbox;
  end;
  with stringGrid1, newcomp1 do begin
    rowCount := newcomp1.Inboxcontents.count+2;
    cells[4,0] := 'Subject';
    cells[3,0] := 'Author';
    cells[2,0] := 'Date';
    cells[1,0] := 'Priority';
    k:=1;
    for i:= Inboxcontents.count-1 downto 0 do begin
      s := inboxcontents.strings[i];
      cells[4,k] := inboxcontents.strings[i];
      cells[3,k] := TVimInboxMsg(inboxcontents.objects[i]).From;
      cells[2,k] := DateToStr(TVimInboxMsg(inboxcontents.objects[i]).date);
      case TVimInboxMsg(inboxcontents.objects[i]).priority of
        low :s:='Low';
        normal:s:='Normal';
        urgent:s:='Urgent';
      end;
      cells[1,k] := s;
      str(k,s);
      cells[0,k] := s;
      objects[0,k] := TObject(TVimInboxMsg(inboxcontents.objects[i]).msgUnRead);
      inc(k);
    end;
  end;
  iCalcGridWidth(stringGrid1);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  doGridDraw(FALSE);
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
VAR N : Word;
begin
  if stringGrid1.cells[1,0] = '' then
    exit;
  with newcomp1 do begin
    getMessage(inboxContents.count-TStringGrid(sender).row);
    deleteMessage(inboxContents.count-TStringGrid(sender).row);
    with TStringGrid(sender) do begin
      if RowCount-1 = FixedRows then
        Exit;
      {move rows up}
      for N := Row to RowCount-2 do
        Rows[N] := Rows[N+1];
      RowCount := RowCount-1;
      Rows[RowCount].Clear;
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i:integer;
begin
i:=1  ;
end;

end.